home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Graphics Programming (2nd Edition)
/
Visual Basic Graphics Programming 2nd Edition.iso
/
OldSrc
/
CH6
/
SRC
/
CYCLOID.FRM
< prev
next >
Wrap
Text File
|
1996-03-28
|
6KB
|
221 lines
VERSION 4.00
Begin VB.Form CycloidForm
Caption = "Cycloid"
ClientHeight = 5310
ClientLeft = 2085
ClientTop = 900
ClientWidth = 4830
Height = 6000
Left = 2025
LinkTopic = "Form1"
ScaleHeight = 354
ScaleMode = 3 'Pixel
ScaleWidth = 322
Top = 270
Width = 4950
Begin VB.TextBox RText
Height = 285
Left = 3285
TabIndex = 8
Text = "15"
Top = 45
Width = 615
End
Begin VB.TextBox PText
Height = 285
Left = 1320
TabIndex = 5
Text = "20"
Top = 45
Width = 615
End
Begin VB.TextBox QText
Height = 285
Left = 2280
TabIndex = 4
Text = "7"
Top = 45
Width = 615
End
Begin VB.TextBox DtText
Height = 285
Left = 240
TabIndex = 3
Text = "0.025"
Top = 45
Width = 615
End
Begin VB.CommandButton CmdGo
Caption = "Go"
Default = -1 'True
Height = 375
Left = 4200
TabIndex = 1
Top = 0
Width = 615
End
Begin VB.PictureBox Canvas
AutoRedraw = -1 'True
Height = 4815
Left = 0
ScaleHeight = -2.2
ScaleLeft = -1.1
ScaleMode = 0 'User
ScaleTop = 1.1
ScaleWidth = 2.2
TabIndex = 0
Top = 480
Width = 4815
End
Begin VB.Label Label1
Caption = "R"
Height = 255
Index = 0
Left = 3120
TabIndex = 9
Top = 60
Width = 255
End
Begin VB.Label Label1
Caption = "P"
Height = 255
Index = 3
Left = 1200
TabIndex = 7
Top = 60
Width = 255
End
Begin VB.Label Label1
Caption = "Q"
Height = 255
Index = 2
Left = 2115
TabIndex = 6
Top = 60
Width = 255
End
Begin VB.Label Label1
Caption = "dt"
Height = 255
Index = 1
Left = 0
TabIndex = 2
Top = 60
Width = 255
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuFileExit
Caption = "E&xit"
End
End
End
Attribute VB_Name = "CycloidForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Const PI = 3.14159
Const TWO_PI = 2 * PI
Dim P As Integer
Dim Q As Integer
Dim R As Integer
Dim P_Q As Single
Dim PQ As Integer
Dim PQR As Integer
' ************************************************
' Draw the curve on the indicated picture box.
' ************************************************
Sub DrawCurve(pic As PictureBox, start_t As Single, stop_t As Single, Dt As Single)
Dim t As Single
pic.Cls
pic.CurrentX = X(start_t)
pic.CurrentY = Y(start_t)
t = start_t + Dt
Do While t < stop_t
pic.Line -(X(t), Y(t))
t = t + Dt
Loop
pic.Line -(X(stop_t), Y(stop_t))
End Sub
' ************************************************
' Non-recursively compute the greatest common
' divisor of to integers.
' ************************************************
Private Function GCD(ByVal a As Integer, ByVal b As Integer) As Integer
Dim B_Mod_A As Integer
B_Mod_A = b Mod a
Do While B_Mod_A <> 0
' Prepare the arguments for the "recursion."
b = a
a = B_Mod_A
B_Mod_A = b Mod a
Loop
GCD = a
End Function
' ************************************************
' Calculate the values t must cross to draw a
' cycloid.
' ************************************************
Sub SetTBounds(tmin As Single, tmax As Single)
tmin = 0
' LCM / P * 2 * PI.
tmax = Q / GCD(P, Q) * TWO_PI
End Sub
' ************************************************
' Find the least common multiple of two integers.
' ************************************************
Function LCM(a As Integer, b As Integer) As Integer
LCM = a * b / GCD(a, b)
End Function
' ************************************************
' The parametric function Y(t).
' ************************************************
Function Y(t As Single) As Single
Y = (PQ * Sin(t) + R * Sin(t * P_Q)) / PQR
End Function
' ************************************************
' The parametric function X(t).
' ************************************************
Function X(t As Single) As Single
X = (PQ * Cos(t) + R * Cos(t * P_Q)) / (PQR)
End Function
Private Sub CmdGo_Click()
Dim tmin As Single
Dim tmax As Single
Dim Dt As Single
P = CInt(PText.Text)
Q = CInt(QText.Text)
R = CInt(RText.Text)
P_Q = P / Q
PQ = P + Q
PQR = PQ + R
SetTBounds tmin, tmax
Dt = CSng(DtText.Text)
DrawCurve Canvas, tmin, tmax, Dt
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub